home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / liboctave / lo-mappers.cc < prev    next >
C/C++ Source or Header  |  1997-07-10  |  6KB  |  344 lines
  1. /*
  2.  
  3. Copyright (C) 1996 John W. Eaton
  4.  
  5. This file is part of Octave.
  6.  
  7. Octave is free software; you can redistribute it and/or modify it
  8. under the terms of the GNU General Public License as published by the
  9. Free Software Foundation; either version 2, or (at your option) any
  10. later version.
  11.  
  12. Octave is distributed in the hope that it will be useful, but WITHOUT
  13. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15. for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with Octave; see the file COPYING.  If not, write to the Free
  19. Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  20.  
  21. */
  22.  
  23. /* Modified by Klaus Gebhardt, 1997 */
  24.  
  25. #ifdef HAVE_CONFIG_H
  26. #include <config.h>
  27. #endif
  28.  
  29. #include <cfloat>
  30.  
  31. #include "lo-error.h"
  32. #include "lo-ieee.h"
  33. #include "lo-mappers.h"
  34. #include "lo-utils.h"
  35. #include "oct-cmplx.h"
  36. #include "oct-math.h"
  37.  
  38. #include "f77-fcn.h"
  39.  
  40. #if defined (_AIX) && defined (__GNUG__)
  41. #undef finite
  42. #define finite(x) ((x) < DBL_MAX && (x) > -DBL_MAX)
  43. #endif
  44.  
  45. extern "C"
  46. {
  47.   double F77_FCN (derf, DERF) (const double&);
  48.   double F77_FCN (derfc, DERFC) (const double&);
  49.   double F77_FCN (dgamma, DGAMMA) (const double&);
  50.   int F77_FCN (dlgams, DLGAMS) (const double&, double&, double&);
  51. }
  52.  
  53. #ifndef M_LOG10E
  54. #define M_LOG10E 0.43429448190325182765
  55. #endif
  56.  
  57. #ifndef M_PI
  58. #define M_PI 3.14159265358979323846
  59. #endif
  60.  
  61. #if defined (HAVE_LGAMMA) && ! defined (SIGNGAM_DECLARED)
  62. extern int signgam;
  63. #endif
  64.  
  65. // Double -> double mappers.
  66.  
  67. double
  68. arg (double x)
  69. {
  70.   if (x < 0.0)
  71.     return M_PI;
  72.   else
  73. #if defined (HAVE_ISNAN)
  74.     return xisnan (x) ? octave_NaN : 0.0;
  75. #else
  76.     return 0.0;
  77. #endif
  78. }
  79.  
  80. double
  81. conj (double x)
  82. {
  83.   return x;
  84. }
  85.  
  86. double
  87. fix (double x)
  88. {
  89.   return x > 0 ? floor (x) : ceil (x);
  90. }
  91.  
  92. double
  93. imag (double x)
  94. {
  95. #if defined (HAVE_ISNAN)
  96.   return xisnan (x) ? octave_NaN : 0.0;
  97. #else
  98.   return 0.0;
  99. #endif
  100. }
  101.  
  102. double
  103. real (double x)
  104. {
  105.   return x;
  106. }
  107.  
  108. double
  109. round (double x)
  110. {
  111.   return D_NINT (x);
  112. }
  113.  
  114. double
  115. signum (double x)
  116. {
  117.   double tmp = 0.0;
  118.   if (x < 0.0)
  119.     tmp = -1.0;
  120.   else if (x > 0.0)
  121.     tmp = 1.0;
  122.  
  123. #if defined (HAVE_ISNAN)
  124.   return xisnan (x) ? octave_NaN : tmp;
  125. #else
  126.   return tmp;
  127. #endif
  128. }
  129.  
  130. double
  131. xerf (double x)
  132. {
  133. #if defined (HAVE_ERF)
  134.   return erf (x);
  135. #else
  136.   double y;
  137.   F77_YXFCN (derf, DERF, y, (x));
  138.   return y;
  139. #endif
  140. }
  141.  
  142. double
  143. xerfc (double x)
  144. {
  145. #if defined (HAVE_ERFC)
  146.   return erfc (x);
  147. #else
  148.   double y;
  149.   F77_YXFCN (derfc, DERFC, y, (x));
  150.   return y;
  151. #endif
  152. }
  153.  
  154. double
  155. xisnan (double x)
  156. {
  157. #if defined (HAVE_ISNAN)
  158.   return (double) (isnan (x) != 0);
  159. #else
  160.   return 0;
  161. #endif
  162. }
  163.  
  164. double
  165. xfinite (double x)
  166. {
  167. #if defined (HAVE_FINITE)
  168.   return (double) (finite (x) != 0);
  169. #elif defined (HAVE_ISINF) && defined (HAVE_ISNAN)
  170.   return (double) (! isinf (x) && ! isnan (x));
  171. #else
  172.   return 1;
  173. #endif
  174. }
  175.  
  176. double
  177. xgamma (double x)
  178. {
  179.   double y;
  180.   F77_YXFCN (dgamma, DGAMMA, y, (x));
  181.   return y;
  182. }
  183.  
  184. double
  185. xisinf (double x)
  186. {
  187. #if defined (HAVE_ISINF)
  188.   return (double) isinf (x);
  189. #elif defined (HAVE_FINITE) && defined (HAVE_ISNAN)
  190.   return (double) (! (finite (x) || isnan (x)));
  191. #else
  192.   return 0;
  193. #endif
  194. }
  195.  
  196. double
  197. xlgamma (double x)
  198. {
  199.   double result;
  200.   double sgngam;
  201.  
  202.   F77_FCN (dlgams, DLGAMS) (x, result, sgngam);
  203.  
  204.   return result;
  205. }
  206.  
  207. // Complex -> double mappers.
  208.  
  209. double
  210. xisnan (const Complex& x)
  211. {
  212. #if defined (HAVE_ISNAN)
  213.   double rx = real (x);
  214.   double ix = imag (x);
  215.   return (double) (isnan (rx) || isnan (ix));
  216. #else
  217.   return 0;
  218. #endif
  219. }
  220.  
  221. double
  222. xfinite (const Complex& x)
  223. {
  224.   double rx = real (x);
  225.   double ix = imag (x);
  226.   return (double) (! ((int) xisinf (rx) || (int) xisinf (ix)));
  227. }
  228.  
  229. double
  230. xisinf (const Complex& x)
  231. {
  232.   return (double) (! (int) xfinite (x));
  233. }
  234.  
  235. // Complex -> complex mappers.
  236.  
  237. Complex
  238. acos (const Complex& x)
  239. {
  240.   static Complex i (0, 1);
  241.  
  242.   return (real (x) * imag (x) < 0.0) ? i * acosh (x) : -i * acosh (x);
  243. }
  244.  
  245. Complex
  246. acosh (const Complex& x)
  247. {
  248.   Complex retval = log (x + sqrt (x*x - 1.0));
  249.   return retval;
  250. }
  251.  
  252. Complex
  253. asin (const Complex& x)
  254. {
  255.   static Complex i (0, 1);
  256.   Complex retval = -i * log (i*x + sqrt (1.0 - x*x));
  257.   return retval;
  258. }
  259.  
  260. Complex
  261. asinh (const Complex& x)
  262. {
  263.   Complex retval = log (x + sqrt (x*x + 1.0));
  264.   return retval;
  265. }
  266.  
  267. Complex
  268. atan (const Complex& x)
  269. {
  270.   static Complex i (0, 1);
  271.   Complex retval = i * log ((i + x) / (i - x)) / 2.0;
  272.   return retval;
  273. }
  274.  
  275. Complex
  276. atanh (const Complex& x)
  277. {
  278.   static Complex i (0, 1);
  279.   Complex retval = log ((1 + x) / (1 - x)) / 2.0;
  280.   return retval;
  281. }
  282.  
  283. Complex
  284. ceil (const Complex& x)
  285. {
  286.   int re = (int) ceil (real (x));
  287.   int im = (int) ceil (imag (x));
  288.   return Complex (re, im);
  289. }
  290.  
  291. Complex
  292. fix (const Complex& x)
  293. {
  294.   return Complex (fix (real (x)), fix (imag (x)));
  295. }
  296.  
  297. Complex
  298. floor (const Complex& x)
  299. {
  300.   int re = (int) floor (real (x));
  301.   int im = (int) floor (imag (x));
  302.   return Complex (re, im);
  303. }
  304.  
  305. Complex
  306. log10 (const Complex& x)
  307. {
  308.   return M_LOG10E * log (x);
  309. }
  310.  
  311. Complex
  312. round (const Complex& x)
  313. {
  314.   double re = D_NINT (real (x));
  315.   double im = D_NINT (imag (x));
  316.   return Complex (re, im);
  317. }
  318.  
  319. Complex
  320. signum (const Complex& x)
  321. {
  322.   return x / abs (x);
  323. }
  324.  
  325. Complex
  326. tan (const Complex& x)
  327. {
  328.   Complex retval = sin (x) / cos (x);
  329.   return retval;
  330. }
  331.  
  332. Complex
  333. tanh (const Complex& x)
  334. {
  335.   Complex retval = sinh (x) / cosh (x);
  336.   return retval;
  337. }
  338.  
  339. /*
  340. ;;; Local Variables: ***
  341. ;;; mode: C++ ***
  342. ;;; End: ***
  343. */
  344.